home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / share / multimed / myflix_win32 / myflix_win32.exe / data1.cab / Libraries / tk8.0 / Entry.tcl < prev    next >
Text File  |  1998-03-10  |  15KB  |  607 lines
  1. # entry.tcl --
  2. #
  3. # This file defines the default bindings for Tk entry widgets and provides
  4. # procedures that help in implementing those bindings.
  5. #
  6. # SCCS: @(#) entry.tcl 1.46 97/08/12 14:28:34
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # mouseMoved -        Non-zero means the mouse has moved a significant
  22. #            amount since the button went down (so, for example,
  23. #            start dragging out a selection).
  24. # pressX -        X-coordinate at which the mouse button was pressed.
  25. # selectMode -        The style of selection currently underway:
  26. #            char, word, or line.
  27. # x, y -        Last known mouse coordinates for scanning
  28. #            and auto-scanning.
  29. #-------------------------------------------------------------------------
  30.  
  31. #-------------------------------------------------------------------------
  32. # The code below creates the default class bindings for entries.
  33. #-------------------------------------------------------------------------
  34.  
  35. bind Entry <<Cut>> {
  36.     clipboard clear -displayof %W
  37.     catch {
  38.     clipboard append -displayof %W \
  39.         [string range [%W get] [%W index sel.first]\
  40.          [expr [%W index sel.last] - 1]]
  41.     %W delete sel.first sel.last
  42.     }
  43. }
  44. bind Entry <<Copy>> {
  45.     clipboard clear -displayof %W
  46.     catch {
  47.     clipboard append -displayof %W \
  48.         [string range [%W get] [%W index sel.first]\
  49.          [expr [%W index sel.last] - 1]]
  50.     }
  51. }
  52. bind Entry <<Paste>> {
  53.     global tcl_platform
  54.     catch {
  55.     if {"$tcl_platform(platform)" != "unix"} {
  56.         catch {
  57.         %W delete sel.first sel.last
  58.         }
  59.     }
  60.     %W insert insert [selection get -displayof %W -selection CLIPBOARD]
  61.     tkEntrySeeInsert %W
  62.     }
  63. }
  64. bind Entry <<Clear>> {
  65.     %W delete sel.first sel.last
  66. }
  67.  
  68. # Standard Motif bindings:
  69.  
  70. bind Entry <1> {
  71.     tkEntryButton1 %W %x
  72.     %W selection clear
  73. }
  74. bind Entry <B1-Motion> {
  75.     set tkPriv(x) %x
  76.     tkEntryMouseSelect %W %x
  77. }
  78. bind Entry <Double-1> {
  79.     set tkPriv(selectMode) word
  80.     tkEntryMouseSelect %W %x
  81.     catch {%W icursor sel.first}
  82. }
  83. bind Entry <Triple-1> {
  84.     set tkPriv(selectMode) line
  85.     tkEntryMouseSelect %W %x
  86.     %W icursor 0
  87. }
  88. bind Entry <Shift-1> {
  89.     set tkPriv(selectMode) char
  90.     %W selection adjust @%x
  91. }
  92. bind Entry <Double-Shift-1>    {
  93.     set tkPriv(selectMode) word
  94.     tkEntryMouseSelect %W %x
  95. }
  96. bind Entry <Triple-Shift-1>    {
  97.     set tkPriv(selectMode) line
  98.     tkEntryMouseSelect %W %x
  99. }
  100. bind Entry <B1-Leave> {
  101.     set tkPriv(x) %x
  102.     tkEntryAutoScan %W
  103. }
  104. bind Entry <B1-Enter> {
  105.     tkCancelRepeat
  106. }
  107. bind Entry <ButtonRelease-1> {
  108.     tkCancelRepeat
  109. }
  110. bind Entry <Control-1> {
  111.     %W icursor @%x
  112. }
  113. bind Entry <ButtonRelease-2> {
  114.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  115.     tkEntryPaste %W %x
  116.     }
  117. }
  118.  
  119. bind Entry <Left> {
  120.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  121. }
  122. bind Entry <Right> {
  123.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  124. }
  125. bind Entry <Shift-Left> {
  126.     tkEntryKeySelect %W [expr [%W index insert] - 1]
  127.     tkEntrySeeInsert %W
  128. }
  129. bind Entry <Shift-Right> {
  130.     tkEntryKeySelect %W [expr [%W index insert] + 1]
  131.     tkEntrySeeInsert %W
  132. }
  133. bind Entry <Control-Left> {
  134.     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
  135. }
  136. bind Entry <Control-Right> {
  137.     tkEntrySetCursor %W [tkEntryNextWord %W insert]
  138. }
  139. bind Entry <Shift-Control-Left> {
  140.     tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
  141.     tkEntrySeeInsert %W
  142. }
  143. bind Entry <Shift-Control-Right> {
  144.     tkEntryKeySelect %W [tkEntryNextWord %W insert]
  145.     tkEntrySeeInsert %W
  146. }
  147. bind Entry <Home> {
  148.     tkEntrySetCursor %W 0
  149. }
  150. bind Entry <Shift-Home> {
  151.     tkEntryKeySelect %W 0
  152.     tkEntrySeeInsert %W
  153. }
  154. bind Entry <End> {
  155.     tkEntrySetCursor %W end
  156. }
  157. bind Entry <Shift-End> {
  158.     tkEntryKeySelect %W end
  159.     tkEntrySeeInsert %W
  160. }
  161.  
  162. bind Entry <Delete> {
  163.     if [%W selection present] {
  164.     %W delete sel.first sel.last
  165.     } else {
  166.     %W delete insert
  167.     }
  168. }
  169. bind Entry <BackSpace> {
  170.     tkEntryBackspace %W
  171. }
  172.  
  173. bind Entry <Control-space> {
  174.     %W selection from insert
  175. }
  176. bind Entry <Select> {
  177.     %W selection from insert
  178. }
  179. bind Entry <Control-Shift-space> {
  180.     %W selection adjust insert
  181. }
  182. bind Entry <Shift-Select> {
  183.     %W selection adjust insert
  184. }
  185. bind Entry <Control-slash> {
  186.     %W selection range 0 end
  187. }
  188. bind Entry <Control-backslash> {
  189.     %W selection clear
  190. }
  191. bind Entry <KeyPress> {
  192.     tkEntryInsert %W %A
  193. }
  194.  
  195. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  196. # Otherwise, if a widget binding for one of these is defined, the
  197. # <KeyPress> class binding will also fire and insert the character,
  198. # which is wrong.  Ditto for Escape, Return, and Tab.
  199.  
  200. bind Entry <Alt-KeyPress> {# nothing}
  201. bind Entry <Meta-KeyPress> {# nothing}
  202. bind Entry <Control-KeyPress> {# nothing}
  203. bind Entry <Escape> {# nothing}
  204. bind Entry <Return> {# nothing}
  205. bind Entry <KP_Enter> {# nothing}
  206. bind Entry <Tab> {# nothing}
  207.  
  208. bind Entry <Insert> {
  209.     catch {tkEntryInsert %W [selection get -displayof %W]}
  210. }
  211.  
  212. # Additional emacs-like bindings:
  213.  
  214. bind Entry <Control-a> {
  215.     if !$tk_strictMotif {
  216.     tkEntrySetCursor %W 0
  217.     }
  218. }
  219. bind Entry <Control-b> {
  220.     if !$tk_strictMotif {
  221.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  222.     }
  223. }
  224. bind Entry <Control-d> {
  225.     if !$tk_strictMotif {
  226.     %W delete insert
  227.     }
  228. }
  229. bind Entry <Control-e> {
  230.     if !$tk_strictMotif {
  231.     tkEntrySetCursor %W end
  232.     }
  233. }
  234. bind Entry <Control-f> {
  235.     if !$tk_strictMotif {
  236.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  237.     }
  238. }
  239. bind Entry <Control-h> {
  240.     if !$tk_strictMotif {
  241.     tkEntryBackspace %W
  242.     }
  243. }
  244. bind Entry <Control-k> {
  245.     if !$tk_strictMotif {
  246.     %W delete insert end
  247.     }
  248. }
  249. bind Entry <Control-t> {
  250.     if !$tk_strictMotif {
  251.     tkEntryTranspose %W
  252.     }
  253. }
  254. bind Entry <Meta-b> {
  255.     if !$tk_strictMotif {
  256.     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
  257.     }
  258. }
  259. bind Entry <Meta-d> {
  260.     if !$tk_strictMotif {
  261.     %W delete insert [tkEntryNextWord %W insert]
  262.     }
  263. }
  264. bind Entry <Meta-f> {
  265.     if !$tk_strictMotif {
  266.     tkEntrySetCursor %W [tkEntryNextWord %W insert]
  267.     }
  268. }
  269. bind Entry <Meta-BackSpace> {
  270.     if !$tk_strictMotif {
  271.     %W delete [tkEntryPreviousWord %W insert] insert
  272.     }
  273. }
  274. bind Entry <Meta-Delete> {
  275.     if !$tk_strictMotif {
  276.     %W delete [tkEntryPreviousWord %W insert] insert
  277.     }
  278. }
  279.  
  280. # A few additional bindings of my own.
  281.  
  282. bind Entry <2> {
  283.     if !$tk_strictMotif {
  284.     %W scan mark %x
  285.     set tkPriv(x) %x
  286.     set tkPriv(y) %y
  287.     set tkPriv(mouseMoved) 0
  288.     }
  289. }
  290. bind Entry <B2-Motion> {
  291.     if !$tk_strictMotif {
  292.     if {abs(%x-$tkPriv(x)) > 2} {
  293.         set tkPriv(mouseMoved) 1
  294.     }
  295.     %W scan dragto %x
  296.     }
  297. }
  298.  
  299. # tkEntryClosestGap --
  300. # Given x and y coordinates, this procedure finds the closest boundary
  301. # between characters to the given coordinates and returns the index
  302. # of the character just after the boundary.
  303. #
  304. # Arguments:
  305. # w -        The entry window.
  306. # x -        X-coordinate within the window.
  307.  
  308. proc tkEntryClosestGap {w x} {
  309.     set pos [$w index @$x]
  310.     set bbox [$w bbox $pos]
  311.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  312.     return $pos
  313.     }
  314.     incr pos
  315. }
  316.  
  317. # tkEntryButton1 --
  318. # This procedure is invoked to handle button-1 presses in entry
  319. # widgets.  It moves the insertion cursor, sets the selection anchor,
  320. # and claims the input focus.
  321. #
  322. # Arguments:
  323. # w -        The entry window in which the button was pressed.
  324. # x -        The x-coordinate of the button press.
  325.  
  326. proc tkEntryButton1 {w x} {
  327.     global tkPriv
  328.  
  329.     set tkPriv(selectMode) char
  330.     set tkPriv(mouseMoved) 0
  331.     set tkPriv(pressX) $x
  332.     $w icursor [tkEntryClosestGap $w $x]
  333.     $w selection from insert
  334.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  335. }
  336.  
  337. # tkEntryMouseSelect --
  338. # This procedure is invoked when dragging out a selection with
  339. # the mouse.  Depending on the selection mode (character, word,
  340. # line) it selects in different-sized units.  This procedure
  341. # ignores mouse motions initially until the mouse has moved from
  342. # one character to another or until there have been multiple clicks.
  343. #
  344. # Arguments:
  345. # w -        The entry window in which the button was pressed.
  346. # x -        The x-coordinate of the mouse.
  347.  
  348. proc tkEntryMouseSelect {w x} {
  349.     global tkPriv
  350.  
  351.     set cur [tkEntryClosestGap $w $x]
  352.     set anchor [$w index anchor]
  353.     if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
  354.     set tkPriv(mouseMoved) 1
  355.     }
  356.     switch $tkPriv(selectMode) {
  357.     char {
  358.         if $tkPriv(mouseMoved) {
  359.         if {$cur < $anchor} {
  360.             $w selection range $cur $anchor
  361.         } elseif {$cur > $anchor} {
  362.             $w selection range $anchor $cur
  363.         } else {
  364.             $w selection clear
  365.         }
  366.         }
  367.     }
  368.     word {
  369.         if {$cur < [$w index anchor]} {
  370.         set before [tcl_wordBreakBefore [$w get] $cur]
  371.         set after [tcl_wordBreakAfter [$w get] [expr $anchor-1]]
  372.         } else {
  373.         set before [tcl_wordBreakBefore [$w get] $anchor]
  374.         set after [tcl_wordBreakAfter [$w get] [expr $cur - 1]]
  375.         }
  376.         if {$before < 0} {
  377.         set before 0
  378.         }
  379.         if {$after < 0} {
  380.         set after end
  381.         }
  382.         $w selection range $before $after
  383.     }
  384.     line {
  385.         $w selection range 0 end
  386.     }
  387.     }
  388.     update idletasks
  389. }
  390.  
  391. # tkEntryPaste --
  392. # This procedure sets the insertion cursor to the current mouse position,
  393. # pastes the selection there, and sets the focus to the window.
  394. #
  395. # Arguments:
  396. # w -        The entry window.
  397. # x -        X position of the mouse.
  398.  
  399. proc tkEntryPaste {w x} {
  400.     global tkPriv
  401.  
  402.     $w icursor [tkEntryClosestGap $w $x]
  403.     catch {$w insert insert [selection get -displayof $w]}
  404.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  405. }
  406.  
  407. # tkEntryAutoScan --
  408. # This procedure is invoked when the mouse leaves an entry window
  409. # with button 1 down.  It scrolls the window left or right,
  410. # depending on where the mouse is, and reschedules itself as an
  411. # "after" command so that the window continues to scroll until the
  412. # mouse moves back into the window or the mouse button is released.
  413. #
  414. # Arguments:
  415. # w -        The entry window.
  416.  
  417. proc tkEntryAutoScan {w} {
  418.     global tkPriv
  419.     set x $tkPriv(x)
  420.     if {![winfo exists $w]} return
  421.     if {$x >= [winfo width $w]} {
  422.     $w xview scroll 2 units
  423.     tkEntryMouseSelect $w $x
  424.     } elseif {$x < 0} {
  425.     $w xview scroll -2 units
  426.     tkEntryMouseSelect $w $x
  427.     }
  428.     set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
  429. }
  430.  
  431. # tkEntryKeySelect --
  432. # This procedure is invoked when stroking out selections using the
  433. # keyboard.  It moves the cursor to a new position, then extends
  434. # the selection to that position.
  435. #
  436. # Arguments:
  437. # w -        The entry window.
  438. # new -        A new position for the insertion cursor (the cursor hasn't
  439. #        actually been moved to this position yet).
  440.  
  441. proc tkEntryKeySelect {w new} {
  442.     if ![$w selection present] {
  443.     $w selection from insert
  444.     $w selection to $new
  445.     } else {
  446.     $w selection adjust $new
  447.     }
  448.     $w icursor $new
  449. }
  450.  
  451. # tkEntryInsert --
  452. # Insert a string into an entry at the point of the insertion cursor.
  453. # If there is a selection in the entry, and it covers the point of the
  454. # insertion cursor, then delete the selection before inserting.
  455. #
  456. # Arguments:
  457. # w -        The entry window in which to insert the string
  458. # s -        The string to insert (usually just a single character)
  459.  
  460. proc tkEntryInsert {w s} {
  461.     if {$s == ""} {
  462.     return
  463.     }
  464.     catch {
  465.     set insert [$w index insert]
  466.     if {([$w index sel.first] <= $insert)
  467.         && ([$w index sel.last] >= $insert)} {
  468.         $w delete sel.first sel.last
  469.     }
  470.     }
  471.     $w insert insert $s
  472.     tkEntrySeeInsert $w
  473. }
  474.  
  475. # tkEntryBackspace --
  476. # Backspace over the character just before the insertion cursor.
  477. # If backspacing would move the cursor off the left edge of the
  478. # window, reposition the cursor at about the middle of the window.
  479. #
  480. # Arguments:
  481. # w -        The entry window in which to backspace.
  482.  
  483. proc tkEntryBackspace w {
  484.     if [$w selection present] {
  485.     $w delete sel.first sel.last
  486.     } else {
  487.     set x [expr {[$w index insert] - 1}]
  488.     if {$x >= 0} {$w delete $x}
  489.     if {[$w index @0] >= [$w index insert]} {
  490.         set range [$w xview]
  491.         set left [lindex $range 0]
  492.         set right [lindex $range 1]
  493.         $w xview moveto [expr $left - ($right - $left)/2.0]
  494.     }
  495.     }
  496. }
  497.  
  498. # tkEntrySeeInsert --
  499. # Make sure that the insertion cursor is visible in the entry window.
  500. # If not, adjust the view so that it is.
  501. #
  502. # Arguments:
  503. # w -        The entry window.
  504.  
  505. proc tkEntrySeeInsert w {
  506.     set c [$w index insert]
  507.     set left [$w index @0]
  508.     if {$left > $c} {
  509.     $w xview $c
  510.     return
  511.     }
  512.     set x [winfo width $w]
  513.     while {([$w index @$x] <= $c) && ($left < $c)} {
  514.     incr left
  515.     $w xview $left
  516.     }
  517. }
  518.  
  519. # tkEntrySetCursor -
  520. # Move the insertion cursor to a given position in an entry.  Also
  521. # clears the selection, if there is one in the entry, and makes sure
  522. # that the insertion cursor is visible.
  523. #
  524. # Arguments:
  525. # w -        The entry window.
  526. # pos -        The desired new position for the cursor in the window.
  527.  
  528. proc tkEntrySetCursor {w pos} {
  529.     $w icursor $pos
  530.     $w selection clear
  531.     tkEntrySeeInsert $w
  532. }
  533.  
  534. # tkEntryTranspose -
  535. # This procedure implements the "transpose" function for entry widgets.
  536. # It tranposes the characters on either side of the insertion cursor,
  537. # unless the cursor is at the end of the line.  In this case it
  538. # transposes the two characters to the left of the cursor.  In either
  539. # case, the cursor ends up to the right of the transposed characters.
  540. #
  541. # Arguments:
  542. # w -        The entry window.
  543.  
  544. proc tkEntryTranspose w {
  545.     set i [$w index insert]
  546.     if {$i < [$w index end]} {
  547.     incr i
  548.     }
  549.     set first [expr $i-2]
  550.     if {$first < 0} {
  551.     return
  552.     }
  553.     set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
  554.     $w delete $first $i
  555.     $w insert insert $new
  556.     tkEntrySeeInsert $w
  557. }
  558.  
  559. # tkEntryNextWord --
  560. # Returns the index of the next word position after a given position in the
  561. # entry.  The next word is platform dependent and may be either the next
  562. # end-of-word position or the next start-of-word position after the next
  563. # end-of-word position.
  564. #
  565. # Arguments:
  566. # w -        The entry window in which the cursor is to move.
  567. # start -    Position at which to start search.
  568.  
  569. if {$tcl_platform(platform) == "windows"}  {
  570.     proc tkEntryNextWord {w start} {
  571.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  572.     if {$pos >= 0} {
  573.         set pos [tcl_startOfNextWord [$w get] $pos]
  574.     }
  575.     if {$pos < 0} {
  576.         return end
  577.     }
  578.     return $pos
  579.     }
  580. } else {
  581.     proc tkEntryNextWord {w start} {
  582.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  583.     if {$pos < 0} {
  584.         return end
  585.     }
  586.     return $pos
  587.     }
  588. }
  589.  
  590. # tkEntryPreviousWord --
  591. #
  592. # Returns the index of the previous word position before a given
  593. # position in the entry.
  594. #
  595. # Arguments:
  596. # w -        The entry window in which the cursor is to move.
  597. # start -    Position at which to start search.
  598.  
  599. proc tkEntryPreviousWord {w start} {
  600.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  601.     if {$pos < 0} {
  602.     return 0
  603.     }
  604.     return $pos
  605. }
  606.  
  607.